home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / joystick.swg / 0006_Two Joysticks.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-31  |  12KB  |  393 lines
  1. ==============================================================================
  2.  BBS: «« The Information and Technology Exchan
  3.   To: MATT CRILL                   Date: 01-05─92 (23:03)
  4. From: DANIEL CHURCHMAN           Number: 4144   [101] PASCAL
  5. Subj: JOYSTICK 1                 Status: Public
  6. ------------------------------------------------------------------------------
  7. Program Joy;  { Read Joystick positions and button states }
  8.  
  9. Uses DOS, Crt;
  10.  
  11. Const
  12.   Buttons          : Byte = 0;
  13.   Joystick         : Byte = 1;
  14.  
  15.   JoyIntr          : Byte = $15;
  16.   JoyFunc          : Byte = $84;
  17.  
  18.   CStart           : Byte = 0; { To hold cursor start line }
  19.   CEnd             : Byte = 0; { To hold cursor end line }
  20.  
  21.   kX               : Real = 6.25; { constant for horizontal conversion }
  22.   kY               : Real = 20.0; { constant for vertical conversion }
  23.  
  24.   LastKey          : Char = ' ';
  25.  
  26. Var
  27.   { Variables for Joystick 1 }
  28.   Joy1Vert         : Word; { Vertical Position }
  29.   Joy1Hori         : Word; { Horizontal Position }
  30.   Joy1But1         : Boolean; { Button 1 }
  31.   Joy1But2         : Boolean; { Button 2 }
  32.  
  33.   { Variables for Joystick 2 }
  34.   Joy2Vert         : Word; { Vertical Position }
  35.   Joy2Hori         : Word; { Horizontal Position }
  36.   Joy2But1         : Boolean; { Button 1 }
  37.   Joy2But2         : Boolean; { Button 2 }
  38.  
  39.   Error            : Boolean; { We'll set this if the joystick isn't found }
  40.  
  41.   Regs             : Registers;
  42.   NewX, NewY       : Byte;
  43.   OldX, OldY       : Byte;
  44.   MinX, MinY,
  45.   MaxX, MaxY       : Word;
  46.  
  47. { Checkjoy and CheckBut are really the only two procedures of real }
  48. { interest to you; the rest is just support code to do something   }
  49. { with the samples.                                                }
  50.  
  51.  
  52. Procedure CheckJoy;
  53.     begin   { Prepare and make Int 15h, subfunction 84h call }
  54.       With Regs do
  55.       begin
  56.         AH := JoyFunc;
  57.         DX := Joystick;  { Subfunction 1 = joystick }
  58.         Intr(JoyIntr, Regs);
  59.         Joy1Hori := AX;
  60.         Joy1Vert := BX;
  61.         Joy2Hori := CX;
  62.         Joy2Vert := DX;
  63.         Error := ((Flags AND FCarry) <> 0)
  64.       end;
  65.     end;
  66.  
  67. Procedure CheckBut;
  68.     Const
  69.       MaskJ1B1     = $10;
  70.       MaskJ1B2     = $20;
  71.       MaskJ2B1     = $40;
  72.       MaskJ2B2     = $80;
  73.     begin   { Prepare and make Int 15h, subfunction 84h call }
  74.       With Regs do
  75.       begin
  76.         AH := JoyFunc;
  77.         DX := Buttons;  { Subfunction 0 = buttons }
  78.         Intr(JoyIntr, Regs);
  79.         Joy1But1 := (AL AND MaskJ1B1) <> MaskJ1B1;
  80.         Joy1But2 := (AL AND MaskJ1B2) <> MaskJ1B2;
  81.         Joy2But1 := (AL AND MaskJ2B1) <> MaskJ2B1;
  82.         Joy2But2 := (AL AND MaskJ2B2) <> MaskJ2B2;
  83.         Error := ((Flags AND FCarry) <> 0)
  84.       end;
  85.     end;
  86.  
  87. Procedure Calibrate;
  88.     Var
  89.       n            : Byte;
  90.     begin
  91.       { Calibrate joystick 1 }
  92.       CheckJoy;
  93.       If Error then
  94.       begin
  95.         Write('No Joystick(s) found - terminating program');
  96.         Halt(1)
  97.       end;
  98.  
  99.       If (Joy1Vert + Joy1Hori) = 0 then
  100.         Writeln('Joystick 1 Absent')
  101.       else
  102.         Writeln('Joystick 1 Present');
  103.       If (Joy2Vert + Joy2Hori) = 0 then
  104.         Writeln('Joystick 2 Absent')
  105.       else
  106.         Writeln('Joystick 2 Present');
  107.  
  108. (*      { Get centre joystick values for X and Y }
  109.       Write('Hold joystick in centre position and press a button');
  110.       Repeat
  111.         CheckBut
  112.       Until (Joy1But1 OR Joy1But2);
  113.       CentreX := 0;
  114.       CentreY := 0;
  115.       For n := 1 to 10 do
  116.       begin
  117.         CheckJoy;
  118.         CentreX := CentreX + Joy1Hori;
  119.         CentreY := CentreY + Joy1Vert;
  120.       end;
  121.       CentreX := CentreX DIV 10;
  122.       CentreY := CentreY DIV 10;
  123.       While (Joy1But1 OR Joy1But2) do  { Wait till button released }
  124.       begin
  125.         CheckBut
  126.       end;
  127.       Writeln('  -  ',CentreX,':',CentreY);
  128. *)
  129.  
  130.       { Get minimum joystick values for X and Y }
  131.       Write('Hold joystick in upper-left position and press a button');
  132.       Repeat
  133.         CheckBut
  134.       Until (Joy1But1 OR Joy1But2);
  135.       MinX := 0;
  136.       MinY := 0;
  137.       For n := 1 to 10 do  { Sample over time for accuracy }
  138.       begin
  139.         CheckJoy;
  140.         { Bias the reading slightly to ensure }
  141.         { we can always reach coord 1,1 }
  142.         MinX := MinX + Word(Round(Joy1Hori * 1.1));
  143.         MinY := MinY + Word(Round(Joy1Vert * 1.1))
  144.       end;
  145.       MinX := MinX DIV 10;
  146.       MinY := MinY DIV 10;
  147.       While (Joy1But1 OR Joy1But2) do  { Wait till button released }
  148.       begin
  149.         CheckBut
  150.       end;
  151.       Writeln('  -  ',MinX,':',MinY);
  152.  
  153.       { Get maximum joystick values for X and Y }
  154.       Write('Hold joystick in bottom-right position and press a button');
  155.       Repeat
  156.         CheckBut
  157.       Until (Joy1But1 OR Joy1But2);
  158.       MaxX := 0;
  159.       MaxY := 0;
  160.       For n := 1 to 10 do   { Sample over time for accuracy }
  161.       begin
  162.         CheckJoy;
  163.         { Bias the reading slightly to ensure }
  164.         { we can always reach coord 80,25 }
  165.         MaxX := MaxX + Word(Round(Joy1Hori * 0.95));
  166.         MaxY := MaxY + Word(Round(Joy1Vert * 0.95))
  167.       end;
  168.       MaxX := MaxX DIV 10;
  169.       MaxY := MaxY DIV 10;
  170.       While (Joy1But1 OR Joy1But2) do  { Wait till button released }
  171.       begin
  172.         CheckBut
  173.       end;
  174.       Writeln('  -  ',MaxX,':',MaxY);
  175.  
  176.       { Important to note that the following calculations of kX and   }
  177.       { kY is done linearly.  This is not really correct, as you'll   }
  178.       { see by the fact that when centred, your screen coords are     }
  179.       { NOT 40,13.  The reason is that the resistors in joysticks     }
  180.       { work on a logarithmic scale.  My knowledge of logs is too     }
  181.       { rusty to build this in properly, so I've skipped it.  What    }
  182.       { you should do is derive the log that correctly passes through }
  183.       { minimum, maximum AND centre.  This way, the joystick, centred }
  184.       { will correctly position your screen coord dead centre, and    }
  185.       { you can still reach the extremes as well.                     }
  186.  
  187.       kX := (MaxX - MinX) / 80;
  188.       kY := (MaxY - MinY) / 25;
  189.       Writeln('kX = ', kX:0:2,'     kY = ',kY:0:2);
  190.  
  191.     end;
  192.  
  193. [Continued]
  194.  
  195.  
  196. --- Msged/sq
  197.  * Origin: C&O Systems, Brisbane, AUSTRALIA (3:640/777)
  198. ==============================================================================
  199.  BBS: «« The Information and Technology Exchan
  200.   To: MATT CRILL                   Date: 01-05─92 (23:04)
  201. From: DANIEL CHURCHMAN           Number: 4145   [101] PASCAL
  202. Subj: JOYSTICK 2                 Status: Public
  203. ------------------------------------------------------------------------------
  204. Procedure SetCoord;
  205.     begin
  206.       If Joy1Hori < MinX then NewX := 1 else
  207.         NewX := Byte(Round((Joy1Hori - MinX) / kX));
  208.       If Joy1Vert < MinY then NewY := 1 else
  209.         NewY := Byte(Round((Joy1Vert - MinY) / kY));
  210.  
  211.       If NewX = 0 then NewX := 1;
  212.       If NewX > 80 then NewX := 80;
  213.       If NewY = 0 then NewY := 1;
  214.       If NewY > 25 then NewY := 25;
  215.  
  216.     end;
  217.  
  218. Procedure MoveIndicator;
  219.     begin
  220.  
  221.       { If the position has changed, clean up old indicator }
  222.       If NOT ((OldX = NewX) AND (OldY = NewY)) then
  223.       begin
  224.  
  225.         { Turn off indicator at old position }
  226.         With Regs do
  227.         begin
  228.           { First, move cursor to old position }
  229.           AH := 2;   { Set cursor position                }
  230.           BH := 0;   { Assume page 0                      }
  231.           DH := OldY - 1; { This value must be zero-based }
  232.           DL := OldX - 1; { This one too                  }
  233.           Intr($10,Regs);
  234.  
  235.           { Now change the attribute }
  236.           AH := 8;   { Read what character is there now                  }
  237.           BH := 0;   { I'm assuming page 0                               }
  238.           Intr($10,Regs);  {AH now holds the attribute, AL the character }
  239.           AH := 9;   { Write Character and Attribute, AL is ok, so...    }
  240.           BL := 31;  { ...only change the attribute                      }
  241.           BH := 0;   { Again, assume page 0                              }
  242.           CX := 1;   { Number of characters to write                     }
  243.           Intr($10,Regs)
  244.         end
  245.       end;
  246.       { Always refresh the current position }
  247.  
  248.       With Regs do
  249.       begin
  250.         { Next, move cursor to new position }
  251.         AH := 2;   { Set cursor position                }
  252.         BH := 0;   { Assume page 0                      }
  253.         DH := NewY - 1; { This value must be zero-based }
  254.         DL := NewX - 1; { This one too                  }
  255.         Intr($10,Regs);
  256.  
  257.         { Then, turn on indicator at NEW position }
  258.         AH := 8;   { Read what character is there now                  }
  259.         BH := 0;   { I'm assuming page 0                               }
  260.         Intr($10,Regs);  {AH now holds the attribute, AL the character }
  261.         AH := 9;   { Write Character and Attribute, AL is ok, so...    }
  262.         BL := 112; { ...change the attribute to black on grey          }
  263.         BH := 0;   { Again, assume page 0                              }
  264.         CX := 1;   { Number of characters to write                     }
  265.         Intr($10,Regs)
  266.  
  267.       end;
  268.  
  269.     end;
  270.  
  271. Procedure InitScreen;
  272.     begin
  273.       GotoXY(26,10);
  274.       Write('Joystick 1        Joystick 2');
  275.       GotoXY(20,12);
  276.       Write('X :');
  277.       GotoXY(20,13);
  278.       Write('Y :');
  279.       GotoXY(14,14);
  280.       Write('Buttons :');
  281.       GotoXY(16,16);
  282.       Write('Error =');
  283.       GotoXY(20,23);
  284.       Write('Press "C" to reCalibrate your joystick');
  285.  
  286.       With Regs do
  287.       begin      { First, save present cursor configuration }
  288.  
  289.         AH := 3; { Read cursor pos and config }
  290.         BH := 0; { Assuming we are using page 0 }
  291.         Intr($10,Regs);
  292.         CStart := CH; { Starting line of cursor }
  293.         CEnd   := CL; { Ending line of cursor }
  294.         { DH holds cursor row }
  295.         { DL holds cursor column }
  296.  
  297.         { Now turn the cursor off - we hope! }
  298.  
  299.         AH := 1;  { Set cursor type }
  300.         CH := $20; { Should cause the cursor to disappear }
  301.         Intr($10,Regs);
  302.  
  303.       end
  304.     end;
  305.  
  306. Procedure GetKey;
  307.     begin
  308.       If KeyPressed then
  309.       begin
  310.         LastKey := ReadKey;  { Read the key in the buffer       }
  311.         If LastKey = #0 then { The key is an extended character }
  312.           LastKey := ReadKey { Read the extended value          }
  313.       end else
  314.         LastKey := #0
  315.     end;
  316.  
  317. [Continued]
  318.  
  319. --- Msged/sq
  320.  * Origin: C&O Systems, Brisbane, AUSTRALIA (3:640/777)
  321. ==============================================================================
  322.  BBS: «« The Information and Technology Exchan
  323.   To: MATT CRILL                   Date: 01-05─92 (23:05)
  324. From: DANIEL CHURCHMAN           Number: 4146   [101] PASCAL
  325. Subj: JOYSTICK 3                 Status: Public
  326. ------------------------------------------------------------------------------
  327. begin
  328.   TextAttr := 31;  { White on Blue - my favourite :-) }
  329.   ClrScr;
  330.  
  331.   Calibrate;
  332.   SetCoord;
  333.  
  334.   InitScreen;
  335.  
  336.   Repeat
  337.     GetKey;  { Simply load the variable LastKey with }
  338.              { a keystroke if one is available       }
  339.     CheckJoy;
  340.     CheckBut;
  341.     OldX := NewX;
  342.     OldY := NewY;
  343.     SetCoord;
  344.     GotoXY(24,12);
  345.     Write(Joy1Hori:10);
  346.     GotoXY(24,13);
  347.     Write(Joy1Vert:10);
  348.     GotoXY(31,14);
  349.     Write((Joy1But1):5,':',(Joy1But2):5);
  350.  
  351.     GotoXY(44,12);
  352.     Write(Joy2Hori:10);
  353.     GotoXY(44,13);
  354.     Write(Joy2Vert:10);
  355.     GotoXY(51,14);
  356.     Write(Byte(Joy2But1),':',Byte(Joy2But2));
  357.  
  358.     GotoXY(37,15);
  359.     Write(NewX:2,':',NewY:2);
  360.  
  361.     GotoXY(24,16);
  362.     Write(Error:5);
  363.  
  364.     Writeln;
  365.     MoveIndicator;
  366.  
  367.     If UpCase(LastKey) = 'C' then
  368.     begin
  369.       ClrScr;
  370.       Calibrate;
  371.       InitScreen
  372.     end;
  373.  
  374.   Until LastKey = #27;
  375.  
  376.   With Regs do
  377.   begin      { Restore original cursor configuration }
  378.  
  379.     AH := 1;  { Set cursor type }
  380.     CH := CStart; { Original cursor start line }
  381.     CL := CEnd;   { Original cursor end line }
  382.     Intr($10,Regs);
  383.     GotoXY(1,24)
  384.   end;
  385.  
  386. end.
  387.  
  388.  
  389.  
  390. [End of code]
  391. --- Msged/sq
  392.  * Origin: C&O Systems, Brisbane, AUSTRALIA (3:640/777)
  393.